{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Macros;

interface

uses Classes, UIObjects, ActionManager, Expressions, XMLHelper;

{$IFDEF DESIGNER}
const
  MODIFY_CAPTION = 'Edit Macro';
  TRIGGER_CAPTION = 'Trigger Macro';

  // Property categories and hints for designer
  CAT_MACRO = 'Macro';
  HINT_FUNCTIONS = 'defines a sequence of function steps for this macro';
{$ENDIF}

type
  TAHMMacroFunction = class(TAHMUIObject)
  private
    FAction: TAHMActionQueueItem;
  protected
    function GetFunctionName: String;
    procedure SetFunctionName(FunctionName: String);
    function GetTargetName: String;
    procedure SetTargetName(TargetName: String);
    function GetParameter: String;
    procedure SetParameter(Parameter: String);
    function GetDesignerInfo: String; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property Action: TAHMActionQueueItem read FAction;
    property FunctionName: String read GetFunctionName write SetFunctionName;
    property TargetName: String read GetTargetName write SetTargetName;
    property Parameter: String read GetParameter write SetParameter;
    procedure Assign(Source: TPersistent); override;
    procedure SaveAsXML(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMMacroFunctionList = class(TAHMUIObjectList)
  public
    constructor Create; override;
    function AddFunction(const InheritFrom, NewName: String): TAHMMacroFunction;
    function GetFunction(const Name: String): TAHMMacroFunction; overload;
    function GetFunction(Index: Integer): TAHMMacroFunction; overload;
    function Modify: Boolean; override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMMacro = class(TAHMUIObject)
  private
    FFunctions: TAHMMacroFunctionList;
  protected
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    function Invoke: Boolean;
    function RenderPreview: Boolean; override;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Functions: TAHMMacroFunctionList read FFunctions;
  end;

  TAHMMacroList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddMacro(const InheritFrom, NewName: String): TAHMMacro;
    function GetMacro(const Name: String): TAHMMacro;
    function InvokeMacro(const Name: String): Boolean;
    function InvokeConditionalMacro(const Name, Expression: String): Boolean;
  end;


implementation

uses SysUtils, TagNames, XMLTags, ApplicationManager, Screen, Functions,
     {$IFDEF DESIGNER}DesignerList,{$ENDIF} AHMTypes;


constructor TAHMMacroFunction.Create(const Name: String);
begin
  inherited;

  ImageIndex := Ord(otFunctions);
  FAction := TAHMActionQueueItem.Create;
end;

destructor TAHMMacroFunction.Destroy;
begin
  FAction.Free;

  inherited;
end;

function TAHMMacroFunction.GetFunctionName: String;
begin
  Result := FAction.FunctionName;
end;

procedure TAHMMacroFunction.SetFunctionName(FunctionName: String);
begin
  FAction.FunctionName := FunctionName;
  Rename(FunctionName);
end;

function TAHMMacroFunction.GetTargetName: String;
begin
  Result := FAction.TargetName;
end;

procedure TAHMMacroFunction.SetTargetName(TargetName: String);
begin
  FAction.TargetName := TargetName;
end;

function TAHMMacroFunction.GetParameter: String;
begin
  Result := FAction.Parameter;
end;

procedure TAHMMacroFunction.SetParameter(Parameter: String);
begin
  FAction.Parameter := Parameter;
end;

function TAHMMacroFunction.GetDesignerInfo: String;
begin
  // Build info for designer list form
  Result := TargetName;
  if Parameter <> '' then Result := Result + ', ' + Parameter;
end;

procedure TAHMMacroFunction.Assign(Source: TPersistent);
begin
  inherited;

  // Assign properties from passed source macro function
  with Source as TAHMMacroFunction do
  begin
    Self.FunctionName := FunctionName;
    Self.TargetName := TargetName;
    Self.Parameter := Parameter;
  end;
end;

procedure TAHMMacroFunction.SaveAsXML(Lines: TStrings);
var
  sWork: String;
begin
  // Not using BeginTag, so need to add name manually
  sWork := TGB+TAG_FUNCTION+SPC+ATTR_NAME+ATB + EncodeXML(FunctionName);

  // Do we need to add target?
  if TargetName <> '' then
    sWork := sWork + ATN+ATTR_TARGET+ATB + EncodeXML(TargetName);
  // Do we need to specify parameter?
  if Parameter <> '' then
    sWork := sWork + ATN+ATTR_PARAMETER+ATB + EncodeXML(Parameter);

  Lines.Add(TABS[3] + sWork + ATE);
end;

procedure TAHMMacroFunction.ParseFromXML(XML: TAHMXMLHelper);
begin
  // Get details of each of the macro function
  FunctionName := XML.GetAttribute(ATTR_NAME);
  TargetName := XML.GetAttribute(ATTR_TARGET);
  Parameter := XML.GetAttribute(ATTR_PARAMETER);
end;

//----------------------------------------------------------------------------//

constructor TAHMMacroFunctionList.Create;
begin
  inherited Create;

  ChildClass := TAHMMacroFunction;
  DefaultSort := lsNatural;
  FSpaceElements := False;
  XMLIndent := 1;
end;

function TAHMMacroFunctionList.AddFunction(const InheritFrom, NewName: String): TAHMMacroFunction;
begin
  Result := TAHMMacroFunction(Inherit(InheritFrom, NewName));
end;

function TAHMMacroFunctionList.GetFunction(const Name: String): TAHMMacroFunction;
begin
  Result := TAHMMacroFunction(GetObject(Name));
end;

function TAHMMacroFunctionList.GetFunction(Index: Integer): TAHMMacroFunction;
begin
  Result := TAHMMacroFunction(GetObject(Index));
end;

function TAHMMacroFunctionList.Modify: Boolean;
begin
{$IFDEF DESIGNER}
  // Edit functions with list dialog
  Result := TfrmObjectList.ShowList(Self, nil, nil);
{$ELSE}
  Result := False;
{$ENDIF}
end;

procedure TAHMMacroFunctionList.ParseFromXML(XML: TAHMXMLHelper);
var
  RootNode, ItemNode: TAHMXMLNode;
begin
  // Store description, comments & prepare for parsing
  RootNode := XML.CurrentNode;
  ItemNode := nil;

  // Keep going as long as we find child tags to process
  while XML.NextElement(RootNode, ItemNode) do
    ParseObjectFromXML(nil, XML);
end;

//----------------------------------------------------------------------------//

constructor TAHMMacroList.Create;
begin
  inherited Create;

  XMLTagName := TAG_GLOBAL_MACROS;
  ChildClass := TAHMMacro;
end;

function TAHMMacroList.AddMacro(const InheritFrom, NewName: String): TAHMMacro;
begin
  Result := TAHMMacro(Inherit(InheritFrom, NewName));
end;

function TAHMMacroList.GetMacro(const Name: String): TAHMMacro;
begin
  Result := TAHMMacro(GetObject(Name));
end;

function TAHMMacroList.InvokeMacro(const Name: String): Boolean;
var
  oMacro: TAHMMacro;
begin
  Result := False;
  oMacro := GetMacro(Name);
  if Assigned(oMacro) then Result := oMacro.Invoke;
end;

function TAHMMacroList.InvokeConditionalMacro(const Name, Expression: String): Boolean;
begin
  // Evaluate expression before calling macro
  Result := ApplicationManagerInstance.ExpressionManager.EvaluateCondition(Expression);

  if Result then
    Result := InvokeMacro(Name);
end;

//----------------------------------------------------------------------------//

constructor TAHMMacro.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_MACRO;
  ObjectType := otMacros;
  ImageIndex := Ord(otMacros);

  FFunctions := TAHMMacroFunctionList.Create;
end;

destructor TAHMMacro.Destroy;
begin
  FFunctions.FreeWithContents;

  inherited Destroy;
end;

procedure TAHMMacro.ClearProperties;
begin
  inherited;

  // Clear custom macro properties
  FFunctions.ClearObjects;
end;

function TAHMMacro.Invoke: Boolean;
begin
  // Delegate macro handling to action manager so we can add to action queue
  Result := ApplicationManagerInstance.ActionManager.EnqueueMacro(Self);
end;

function TAHMMacro.RenderPreview: Boolean;
begin
{$IFDEF DESIGNER}
  with ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    Canvas.TextRect(ViewportRect, nil, 'Macro Functions:' + sLineBreak + FFunctions.Text);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMMacro.ModifyActions: Integer;
begin
  // Macro only supports editing & trigger functions
  Result := 2;
end;

function TAHMMacro.Modify(Action: Integer): Boolean;
begin
{$IFDEF DESIGNER}
  Result := False;

  case Action of
    0: // Edit functions with list dialog
       Result := TfrmObjectList.ShowList(FFunctions, nil, nil);
    1: // Invoke macro for testing (only if no actions pending)
       if ApplicationManagerInstance.ActionManager.IsQueueEmpty then Invoke;
  end;

  if Result then DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMMacro.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  case Action of
    0: Result := MODIFY_CAPTION;
    1: Result := TRIGGER_CAPTION;
    else Result := '';
  end;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMMacro.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
    Functions.AddFunction('', 'Function 1').FunctionName := FN_NONE;
{$ENDIF}
end;

procedure TAHMMacro.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMMacro do
  begin
    Self.Functions.AssignContents(Functions);
  end;
end;

procedure TAHMMacro.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMMacro;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMMacro(ObjectToCompare);

  // Save XML for function steps
  FFunctions.SaveDiffsAsXML(oAncs.Functions, Lines);
end;

procedure TAHMMacro.ParseFromXML(XML: TAHMXMLHelper);
begin
  // A macro consists of a number of function tags
  FFunctions.ParseFromXML(XML);
end;

procedure TAHMMacro.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom macro properties
  Properties.Add('Functions', 'Functions', CAT_MACRO, HINT_FUNCTIONS);
{$ENDIF}
end;

end.
